home *** CD-ROM | disk | FTP | other *** search
- /*
-
- Object pseudo class definition for GCOOPE Version 1.0
-
- by Brian Lee Price
-
- Released as Public Domain July, 1994.
-
- This is the pseudo-class definition for the base object
- 'Object' [this is termed a pseudo class definition because
- it makes use of low level kernel functions to install itself,
- unlike a 'real' class definition which will use the program
- interface kernel routines]
-
- */
-
- #define __OBJECT_DEFINITION__
-
- #include "gcstruct.h"
-
- #include <stdarg.h>
- #include <stdlib.h>
- #include <stdio.h>
- #include <mem.h>
- #include <ctype.h>
-
- /* the pseudo class definition for Object */
-
- static classEntry obj;
-
- /* first define the methods */
-
- /* note that there is no default method for New */
-
- /*
- AVAILABLE AS DEFAULT Kill routine.
-
- This routine will take the place of a missing class's kill
- routine as well as actually killing off the object when all the
- proper conditions are met.
- */
-
- static object kill(object instance,...)
- {
- va_list ap;
- classEntry * clsEnt;
- superEntry * parent;
- char * objDef;
- int class;
- int x;
- object newInst;
-
- if(instance!=Object) /* not explicit call ? */
- {
- /* we must take the place of a missing kill routine */
- if(NULL==(objDef=getObjDef((tag) instance)))
- {
- g(Err)(Object,instance,gcerrmsg[ERR_BAD_HANDLE]);
- goto end;
- }
- objDef+=((objHndl *) &instance)->fext;
- class=*((tag *) objDef);
- if(NULL==(clsEnt=getObjDef(class)))
- {
- g(Err)(Object,(object) class,gcerrmsg[ERR_BAD_CLASS-
- FIRST_GCOOPE_ERROR]);
- goto end;
- }
- (char *) parent = &(clsEnt->cVars[clsEnt->cvSize]);
- for(x=clsEnt->numSuper;x>0;x--,parent++)
- {
- newInst=instance;
- ((objHndl *) &newInst)->fext+=parent->offset;
- g(Kill)(newInst);
- }
- }
- else
- {
- va_start(ap, instance);
- instance=va_arg(ap, object);
- va_end(ap);
- if(NULL==(objDef=getObjDef((tag) instance)))
- {
- g(Err)(Object, instance,gcerrmsg[ERR_BAD_HANDLE-
- FIRST_GCOOPE_ERROR]);
- goto end;
- }
- }
- if(instance>=0 && ((objHndl *) &instance)->fext) goto end; /* not owner */
- rmvObject((tag) instance);
- if(instance<0) goto end; /* no iv block */
- s_free(objDef);
- return (object) objDef;
-
- end:
- return (object) NULL;
- }
-
-
- typedef union {
- unsigned int hex[32];
- unsigned char ascii[64];
- } stackDump;
-
-
- /*
- AVAILABLE AS DEFAULT Err ROUTINE.
-
- This routine prints out on stderr all the currently available
- information (including a stack dump) concerning the error encountered.
- It then terminates the program via. abort.
- */
-
- static object err(object instance,...)
- {
- va_list ap;
- int xcall=0;
- char * objDef;
- classEntry * clsEnt;
- int x,y;
- stackDump * dump;
-
- va_start(ap, instance);
- if(instance==Object)
- {
- xcall=1;
- instance=va_arg(ap, object);
- }
- fprintf(stderr,"\nRun time error - GCOOPE Version 1.0 SDK kernel:\n");
- fprintf(stderr,"Passed handle: %p \n",(void *) instance);
- if(!xcall)
- fprintf(stderr,"Undefined error; probable bad alias for generic\n");
- else
- {
- if(instance!=Object)
- {
- objDef=getObjDef((tag) instance);
- if(objDef==NULL) fprintf(stderr,"Bad calling instance \n");
- else
- {
- objDef+=((objHndl *) instance)->fext;
- clsEnt=getObjDef(*((tag *) objDef));
- if(clsEnt==NULL) fprintf(stderr,"Bad instance class \n");
- else fprintf(stderr,"Calling class: %x \n",(tag) instance);
- }
- }
- else fprintf(stderr,"Called by kernel function \n");
- fprintf(stderr,"Error Message: %s \n",va_arg(ap,char *));
- }
- va_end(ap);
- fprintf(stderr,"Stack Dump:");
- va_start(ap, instance);
- dump=(stackDump *) ap;
- dump++;
- for(x=0,y=-1;x<32;)
- {
- fprintf(stderr,"\n\t%04x %04x %04x %04x %c%c%c%c%c%c%c%c",
- dump->hex[x++], dump->hex[x++], dump->hex[x++], dump->hex[x++],
- (iscntrl(dump->ascii[++y]))?'.':dump->ascii[y],
- (iscntrl(dump->ascii[++y]))?'.':dump->ascii[y],
- (iscntrl(dump->ascii[++y]))?'.':dump->ascii[y],
- (iscntrl(dump->ascii[++y]))?'.':dump->ascii[y],
- (iscntrl(dump->ascii[++y]))?'.':dump->ascii[y],
- (iscntrl(dump->ascii[++y]))?'.':dump->ascii[y],
- (iscntrl(dump->ascii[++y]))?'.':dump->ascii[y],
- (iscntrl(dump->ascii[++y]))?'.':dump->ascii[y]);
- }
- va_end(ap);
- fprintf(stderr,"\n");
- abort();
- return (object) NULL;
- }
-
-
- /*
- The following default method returns the class of the CURRENT
- instance. If you want the owning class then for non flag class
- instances you must set the fext field to zero.
-
- Note: this routine may be called by passing Object as the inst
- parm, in that case, the instance is first variable argument parm.
- */
-
-
- static object getClassOf(object inst,...)
- {
- object class=0;
- char * objClass;
- va_list ap;
-
- va_start(ap, inst);
- if(inst==Object) inst=va_arg(ap, object);
- va_end(ap);
-
- if(inst>=0)
- {
- if(NULL==(objClass=getObjDef((tag) inst))) goto end;
- objClass+=((objHndl *) &inst)->fext;
- (tag) class = *((tag *) objClass);
- }
- else
- {
- (tag) class = ((objHndl *) &inst)->fext & SIGNMASK;
- }
-
- end:
- return class;
- }
-
-
- /*
- This default method returns the size of the instance variable
- structure for the current instance. It may be called with Object
- as the first parameter in which case the actual instance is the
- first variable argument parameter.
-
- */
-
- static object getIVsize(object inst,...)
- {
- object retVal=-1;
- tag * clsNdx;
- classEntry * clsEnt;
- va_list ap;
-
- va_start(ap, inst);
- if(inst==Object) inst=va_arg(ap,object);
- va_end(ap);
-
- if(inst<0)
- {
- if(NULL==(clsEnt=getObjDef(SIGNMASK & ((objHndl *) &inst)->fext)))
- goto end;
- }
- else
- {
- if(NULL==(clsNdx=getIVptr(inst))) goto end;
- if(NULL==(clsEnt=getObjDef(clsNdx[-1]))) goto end;
- }
- retVal=(object) clsEnt->ivSize;
-
- end:
- return retVal;
- }
-
- /*
- This default method allows you to see if an instance responds
- to a given generic function without calling via g and causing
- an error. The instance parameter may be equal to Object, in that
- case the actual instance is the first variable argument parameter.
- In any case the first variable argument parameter after the actual
- instance is of type generic and is the generic function index.
- */
-
- static object defRespondsTo(object instance,...)
- {
- object class;
- generic genFunc;
- va_list ap;
-
- va_start(ap,instance);
- if(instance==Object) instance = va_arg(ap, object);
- genFunc=va_arg(ap, generic);
- va_end(ap);
-
- class=getClassOf(instance);
- return (object) getMthd(genFunc, (tag)class);
- }
-
-
- /*
-
- This default method performs a full (or deep) copy function.
- The instance parm is the object to be copied, this method will return
- an object handle to a new instance that is an exact duplicate of the
- old. If the instance is of class Class, this method will return 0.
-
- If the instance parm is equal to Object, the actual instance is
- the first variable argument parameter.
-
- For instances of classes that maintain a dynamically allocated
- memory area as part of their instance data, a class method for deepCopy
- should be defined that correctly creates and copies a new dynamically
- allocated area for the newly created object instance.
-
- */
-
-
- static object defDeepCopy(object instance,...)
- {
- object newObj=0;
- object class;
- tag oldfext;
- objectEntry * objEnt;
- classEntry * clsEnt;
- void * newInst;
- void * oldInst;
- va_list ap;
-
- va_start(ap,instance);
- if(instance==Object) instance=va_arg(ap, object);
- va_end(ap);
-
- if(instance<0)
- {
- newObj=instance;
- goto end;
- }
- if(Class==(class=getClassOf(instance))) goto end;
- if(NULL==(clsEnt=getObjDef((tag) class))) goto end;
- oldfext=((objHndl *) &instance)->fext;
- ((objHndl *) &instance)->fext=0;
- if(NULL==(objEnt=getObject((tag) instance))) goto end;
- if(NULL==(oldInst=objEnt->objDef)) goto end;
- newInst=s_malloc(clsEnt->totSize);
- memcpy(newInst, oldInst, clsEnt->totSize);
- if((newObj=addObject(newInst, objEnt->procID))<0) goto err;
- ((objHndl *) &newObj)->fext=oldfext;
-
- end:
- return newObj;
-
- err:
- s_free(newInst);
- return 0;
- }
-
-
- /*
- This default method performs a shallow copy function. In this
- method, only the current instance portion of the source instance is
- copied to the destination instance. The source parameter is of type
- object and is the variable argument parameter immeadiately following
- the actual destin parameter. This method will return 0 on error and
- will not copy an instance of class Class.
-
- Note: This method may be called with destin==Object, in that
- case the actual destin parameter is the first variable argument parm
- and the source is the second variable argument parm.
-
- As with deepCopy above, classes that use dynamically allocated
- memory areas as part of their instance variables should define a
- method for this generic that correctly copies those areas.
-
- */
-
- static object defShallowCopy(object destin,...)
- {
- object retVal=0;
- object source;
- object srcClass;
- void * destIV;
- void * srcIV;
- int size;
- va_list ap;
-
- va_start(ap,destin);
- if(destin==Object) destin=va_arg(ap, object);
- source=va_arg(ap, object);
- va_end(ap);
-
- if((srcClass=getClassOf(source))<0) goto end;
- if(srcClass==Class) goto end;
- if((getClassOf(destin)!=srcClass) &&
- (0==(destin=steer(srcClass, destin)))) goto end;
- size = (int) getIVsize(source);
- if(destin<0)
- {
- if(source<0) return destin=source;
- if(NULL==(srcIV=getIVptr(source))) goto end;
- switch(size) {
- case sizeof(byte) : (byte) destin = *((byte *) srcIV);break;
- case sizeof(short) : (short) destin = *((short *) srcIV); break;
- #if sizeof(short)!=sizeof(int)
- case sizeof(int) : (int) destin = *((int *) srcIV); break;
- #endif
- default : goto end;
- }
- }
- else
- {
- if(NULL==(destIV=getIVptr(destin))) goto end;
- if(source<0)
- {
- switch(size) {
- case sizeof(byte) : *((byte *) destIV) = (byte) source; break;
- case sizeof(short) : *((short *) destIV) = (short) source; break;
- #if sizeof(short)!=sizeof(int)
- case sizeof(int) : *((int *) destIV) = (int) source; break;
- #endif
- default : goto end;
- }
- }
- else
- {
- if(NULL==(srcIV=getIVptr(source))) goto end;
- memcpy(destIV, srcIV, size);
- }
- }
- retVal=destin;
-
- end:
- return retVal;
- }
-
-
-
- /*
- FOR KERNEL USE ONLY.
-
- This routine installs the pseudo-class Object and initializes the
- main generic functions.
- */
-
- stat Object_Install(void)
- {
- stat ret=FUNCFAIL;
-
- /* first add the Object definition to the objList and the name to symList */
-
- Object=(object) 0L;
- if((((objHndl *) &Object)->tag=addObject(&obj,PERM_PROC_ID))<0) goto end;
-
- /* now initialize the generic functions */
-
- if(MAX_GEN==(New=addGeneric((method) NULL))) goto end;
- if(MAX_GEN==(Kill=addGeneric(kill))) goto end;
- if(MAX_GEN==(Err=addGeneric(err))) goto end;
- if(MAX_GEN==(GFclassOf=addGeneric(getClassOf))) goto end;
- if(MAX_GEN==(GFivSize=addGeneric(getIVsize))) goto end;
- if(MAX_GEN==(GFrespondsTo=addGeneric(defRespondsTo)))
- goto end;
- if(MAX_GEN==(GFdeepCopy=addGeneric(defDeepCopy))) goto end;
- if(MAX_GEN==(GFshallowCopy=addGeneric(defShallowCopy)))
- goto end;
-
-
- ret=FUNCOKAY;
-
- end:
- return ret;
- }
-
-
-